perm filename 68KASM.VRP[UP,DOC] blob
sn#539197 filedate 1980-10-09 generic text, type T, neo UTF8
(cgol)$
%========================= 68000 Assembler =========================%
% This is a Lisp program to assemble 68000 assembly language programs.
Although it is written in Cgol the compiled version may be run independently of
Cgol.
Usage at SAIL:
Get a Maclisp (type "lisp" to the monitor, answer N or <space> to the Alloc?)
(load '(assem fas (68k sys)))
(load '(sqrt 68k (1 vrp)))
(aload sqrt $1000)
This will print on your terminal the assembled code for a square root
routine, in the downloader format used on Motorola's design module for the
68000.
To get at an earlier stage of this process, try
(assemble sqrt $1000)
which will return as a value (as opposed to print as a side effect) a list
of integers in the range 0 to 2**16-1. These are the 16-bit instructions
and data of the assembled code. (download x $1000) where x is such a
list will do the other half of the job done by aload (assemble-and-load).
(Note that the assem.fas module sets the output base to 16. while leaving the
input base at 10. - to enter hex constants precede them with $ (dollar).
(setq base 10.) will reset the printout to decimal instead of hexadecimal.)
====FUNCTIONS====
The most useful functions are as follows.
(ASSEMI <instruction>)
Produces a word list, a list of 16-bit (unsigned) numbers constituting
the assembled instructions
Example: (ASSEMI '(MOVE D2 A5)) -> (10818) (or (2A42) in hexadecimal)
(ASSEMI '(JMP 324)) -> (20220 0 324)
(ASSEMBLE <instruction list> <origin>)
Produces a word list. <origin> supplies the default origin, which may
be reset by <instruction list>.
(DOWNLOAD <word list> <origin>)
Type out <word list> as 'S' records in image mode on the console
Suitable for downloading to the 68000 Macsbug monitor
(ALOAD <instruction list> <origin>)
(ALOAD i o) = (DOWNLOAD (ASSEMBLE i o) o), i.e. combines ASSEMBLE and
DOWNLOAD into one function.
====FORMATS====
<instruction> Either an atom or a list. If an atom then it is taken
to be a label. If a list then if its car is "setq" or
"org" then it is to be evaluated for its side effect,
with the side effect of (org x) being to set the
variable "here" to the value of x. Otherwise it is
a list of length 1 to 4, of the form
(<op> [<size>] [<source> [<destination>]])
Examples: (org 128) (unlk) (bra partb) (move d2 d4) partb (sub w d2 a5).
<op> An atom, one of add,move,neg, etc (see table below)
<size> An atom, one of b or w (for byte or word). If absent,
l (long) is assumed.
<source>,<destination> Either an atom or a list. If an atom, either a
register (D3,A7), a number, a symbol having a
numeric value, or one of SR, CCR, USP. Numbers are
decimal unless preceded by $ as in $FFE6 in which case
they are hexadecimal.
Numbers and symbols with numeric values are taken to be
immediate data (constants as opposed to addresses).
If a list, either an <indirect>, a multiple-register
expression of the form (M <regs>), or an <expression>
whose value is taken to be immediate data.
<indirect> A list containing some of (- An + PC Dn n) in that
order. The legal combinations are given in the table
called MODETABLE below. (S and L refer to Short and
Long values of n respectively in that table.) For An
and Dn, n is in the range 0 to 7. For n, n is in the
range -32768 to 32767 for Short n, -2**31 to 2**31-1
for Long n. n may be given either as a constant
(signed or unsigned, decimal or hexadecimal) or as an
expression to be evaluated to yield a number.
<regs> For now, this is just a number whose bits give the
registers for a MOVEM instruction. Thus 12 would
specify registers D3 and D2. The assembler does the
necessary reversing of these bits, so the same register
correspondence with bit positions may be used for all
variants of the MOVEM instruction.
<expression> Must have the form (+ exp1 exp2 ...) when used as
direct address; any form for n in <indirect>. expi is
any s-expression with a numeric value. The numeric
value of the expression is used as would a number in
the same place. Thus (bra (+ done 2)) will branch to
a location two bytes past location "done" while
(jmp (pc d4 (* 2 wds))) will jump via pc+d4+2*wds.%
%========================= Assembler Implementation =========================%
% Advice to Lisp Compiler %
=(let readtable = lispsyn; cgolchar(":");0) $
declare(fixsw := t)$
special opr,size,sce,dest,here,chksum,modetable,m,n,
k,type,mode,smode,dmode,reg,sreg,dreg,ext,sext,dext,instr $
%========================= Auxiliary routines =========================%
sstatus(#+,t)$
new defaultf, fasload; load modcat fasl dsk liblsp$
define gripe(x); newline; princ(x ↑ " - " ↑ instr); throw nil $
define org(i); here := i $
setsyntax('?$', 'macro', '\;let ibase = 16; readlist("+".explodec read())') $
=(codes := !'(D A K J E DD AA DA AD OD KD KA II PP DX XD EA ED DE AK OE KE JA
EE KS KC EC ES SE AU UA IM JM MP MJ);
(infix "|" 25 ["BOOLE",1,left,2**right-1]);
(prefix "{" 0 "INSTR" . rightlist & check "}");
(prefix "CASE" 0
new table; while token ne "?≠" do table := table @ [[token&advance,right]];
let keys = car[table], m = lsh(1,length(codes)-1);
let set = +{for i in codes collect (if i isin keys then m else 0 &
m := lsh(m,-1))};
sublis(['set'.set, 'table'.table],
'let xc = boole(1,type,set);
if xc = 0 then gripe "This operand illegal for";
eval cadr(assoc(codetable(haulong lsh(xc,-1)),'table'))'));
0) $
codes := !'(D A K J E DD AA DA AD OD KD KA II PP DX XD EA ED DE AK OE KE JA
EE KS KC EC ES SE AU UA IM JM MP MJ);
define instr(op,reg1,siz,mode,reg2,ext); % assemble instruction %
(((op*8+reg1)*8+siz)*8+mode)*8+reg2
. (if ext>1 then sext)
@ (if oddp ext then dext) $
define siz(n); if size = 2 then sext := cdr sext; size := n $
define wl(); if size = 0 then gripe "Byte size illegal" $
define noa(); gripe "Illegal operation on address register" $
% Set up tables %
for R in !'(D A) do for n in 0 to 7 do
'dir' of (R↑n) := 'indir' of (R↑n) := [R,n];
for i in !'(SR CCR USP) do 'dir' of i := [i];
for i in !'(+ - PC) do 'indir' of i := [i];
%=========================% MODETABLE %=========================% := !'(
;Key Mode Reg Type Explanation
(D 0 reg D) ; Data Register Direct, Dn
(A 1 reg A) ; Address Register Direct, An
(O 7 4 O) ; Immediate, 0<k<9
(K 7 4 K) ; Immediate
(SR 7 4 S) ; Status Register
(CCR NIL NIL C) ; Condition Code Register
(USP NIL NIL U) ; User Stack Pointer
(M NIL NIL M) ; Multiple Registers
((A) 2 reg J) ; Indirect, (An)
((A +) 3 reg I) ; postIncrement, (An+)
((- A) 4 reg P) ; Predecrement, (-An)
((A S) 5 reg X) ; Indirect with Displacement, d(An)
((A D) 6 reg J) ; Indirect with Index, d(An,ix)
((A D S)6 reg J) ; Indirect with Index, d(An,ix)
((S) 7 0 J) ; Absolute Short, xxx.W
((L) 7 1 J) ; Absolute Long, xxx.L
((PC) 7 2 J) ; Program Counter
((PC S) 7 2 J) ; Program Counter with Displacement, d(PC)
((PC D) 7 3 J) ; Program Counter with Index, d(PC,ix)
((PC D S)7 3 J) ; Program Counter with Index, d(PC,ix)
);
if not '#array' of 'codetable' then array(codetable,t,length codes);
fillarray('codetable',reverse codes);
types := !'(
(O K E) (K E) (D E) (A E) (J E) (P E) (I E) (X J E) (C) (S) (U) (M) (Z NIL));
% Compute filters generated by types %
for ind in !'(sce dest), n in [0,1] do
for i in types do
(m := lsh(1,length(codes)-1);
ind of car i := +{for j in nth[[n),explode[codes]] collect
(if j isin i then m else 0 & m := lsh(m,-1))}) $
%========================= Assembly routines =========================%
define type(opd);
new idx;
let x = assoc(if atom opd then
if numberp opd then immnum(opd)
else (let x = 'dir' of opd;
if x then (car x & if cdr x then reg := cadr x)
else immnum(eval opd))
else if car opd = "M"
then (ext := [cadr opd]; "M")
else if car opd = "+" then immnum(eval opd)
else for i in opd collect
if numberp i then disp(i)
else let x = 'indir' of i;
if null x then disp(eval i)
else (if car x = "D" then idx := cadr x
else if cdr x then reg := cadr x;
car x),
modetable);
if null x then gripe "Improper operand";
if (idx or not atom car x and "PC" isin car x) and null ext then ext := [0];
if idx then if null cdr ext and -129 < car ext < 128
then ext := [idx*256+(car ext)|8]
else gripe "Displacement too big";
mode := cadr x; reg := eval caddr x; cadddr x $
define immnum(x);
k := x;
if -32769 < x < 32768 and size < 2 then ext := [x]
else if size = 2 then ext := [lsh(x,-16)|16,x|16]
else gripe "Immediate data too large for byte or word operation";
if 0 < x < 9 then "O" else "K" $
define disp(i);
if -32769 < i < 32768 then (ext := [i]; "S")
else (ext := [lsh(i,-16)|16,i|16]; "L") $
define assemi(instr);
catch(
new i,opr,size,sce,dest,last,mop,type,ext,sext,dext;
type := 0;
opr := car instr; i := cdr instr;
mop := 'meaning' of opr or gripe "Undefined operation";
size := if car i isin !'(b w)
then (if car i = 'b' then 0 else 1 & i := cdr i)
else 2;
if i then (sce := last := car i; i := cdr i;
type := 'sce' of type(sce);
sext := ext; ext := nil; sreg := reg; smode := mode);
if i then (dest := last := car i;
type := boole(1,type,'dest' of type(dest));
dext := ext; dreg := reg; dmode := mode)
else type := boole(1,type,'dest' of "Z");
if (numberp last or not atom last and 'pc' isin last)
and opr ne 'btst' and car mop not isin !'(bra jmp link stop trap)
then gripe "Destination not alterable";
eval('meaning' of opr)) $
define assemble(source,origin);
new code, here, stable; here := origin;
for i in source do
if atom i then (if not numberp i then set(i,here))
else if car i isin !'(setq org) then eval i
else here := here + 3;
while not stable do
(stable := t; here := origin;
code :=
for i in source coalesce
if atom i
then if numberp i then nil
else (if not boundp i or (eval i) ne here
then (set(i,here); stable := nil))
else if car i isin !'(setq org) then (eval i; nil)
else let obj = assemi(i); here := here + 2 * length obj; obj);
code $
define download(x,adr); % x is a list of words, i.e. integers 0-65535 %
open(tyo,'image');
print "S0030000FC";
while length x > 16 do
(newline; prin1 "S1"; chksum := 0; outc(35); outc(lsh(adr,-8)); outc(adr);
16 lotsof (outc(lsh(car x,-8)); outc(car x); x := cdr x);
outc((255-chksum) mod 256); adr := adr+32);
newline; prin1 "S1"; chksum := 0;
outc(3+2*length x); outc(lsh(adr,-8)); outc(adr);
while x do (outc(lsh(car x,-8)); outc(car x); x := cdr x);
outc((255-chksum) mod 256);
print "S9030000DC"; newline;
open(tyo,'ascii') $
define outc(b); hex(lsh(b,-4)); hex(b); chksum := chksum + b $
define hex(d);
d := boole(1,d,15);
prin1(if d < 10 then d else maknam([d+55])) $
define aload(source,origin); download(assemm(source,origin),origin) $
%========================= 68000 op codes =========================%
=(new x; while token ne "?≠" do x:=x@[[token&advance,parse(20)]];
subst(x,'x','for i in 'x' do 'meaning' of car i := cadr i; 'ops''))
abcd bcd(12) add ads(4) addi imm(3) addq qtyp(0)
addx da(13) and lgc(1) andi lgci(1) asl sh(4,0)
asr sh(0,0) bcc bra(4) bchg bit(1) bclr bit(2)
beq bra(7) bge bra(12) bgt bra(14) bhi bra(2)
ble bra(15) bls bra(3) blt bra(13) bmi bra(11)
bne bra(6) bpl bra(10) bra bra(0) bset bit(3)
bsr bra(1) btst bit(0) bvc bra(8) bvs bra(9)
chk chk() clr oea(1) cmp cmp() cmpi imm(6)
divs md(8,7) divu md(8,3) eor eor() eori lgci(5)
exg exg() ext ext() jmp jmp(7,3) jsr jmp(7,2)
lea lea() link link() lsl sh(4,1) lsr sh(0,1)
move move() movep movep() moveq moveq() muls md(12,7)
mulu md(12,3) nbcd tn(4,0) neg oea(2) negx oea(0)
nop [20081] not oea(3) or lgc(0) ori lgci(0)
pea jmp(4,1) reset [20080] rol sh(4,2) ror sh(0,2)
roxl sh(4,3) roxr sh(0,3) rte [20083] rtr [20087]
rts [20085] sbcd bcd(8) scc s(4) seq s(7)
sf s(1) sge s(12) sgt s(14) shi s(2)
sle s(15) sls s(3) slt s(13) smi s(11)
sne s(6) spl s(10) ssr s(1) st s(0)
stop stop() sub ads(9) svc s(8) svs s(9)
subi imm(2) subq qtyp(4) subx da(9) swap swap()
tas tn(5,3) trap trap() trapv [20086] tst oea(5)
unlk unlk() sub ads(0) $
%========================= Opcode Definitions =========================%
% Each case includes on the right hand side an example of its use %
define ads(m); % m: 0->sub, 4->add % case
KA wl(); if size = 2 and -32769<k<32768 then (size := 1; sext := cdr sext);
{9+m,dreg,4*size-1,smode,sreg,2} %(ADD 3 A2): (152774 3) %
EA wl(); {9+m,dreg,4*size-1,smode,sreg,2} %(SUB (A5) A2): (112725) %
OD {5,k|3,4-m+size,dmode,dreg,0} %(SUB 5 D1): (55601) %
KD {9+m,dreg,size,7,4,2} %(ADD W 9 D1): (151174 11) %
OE {5,k|3,4-m+size,dmode,dreg,1} %(ADD 6 (A4 +)):(56234) %
KE {0,2+m/:4,size,dmode,dreg,3} %(SUB 9 (A5 2)):(02255 0 11 2)%
ED {9+m,dreg,size,smode,sreg,2} %(SUB (PC 3) D6): (116272 3)%
DE {9+m,sreg,4+size,dmode,dreg,1}$ %(ADD D6 (A5 D2 3)): (156665 1003)%
define bcd(opr); size := 0; da(opr) $
define bit(m); case
EA noa()
DE {0,sreg,4+m,dmode,dreg,1} %(BCLR D3 (A5)): (03625)%
KE {0,4,m,dmode,dreg,3} $ %(BCHG 2 (5)): (04170 0 2 5)%
define bra(m);
let n = lsh(6,12)+lsh(m,8); k := k-2-here;
if not -32769 < k < 32768 then gripe "Branch out of range"
else case
K if -129 < k < 128 then [n+k|8] else [n,k|16] $ %(BMI 37): (65445)%
define chk(); case
AD noa()
ED {4,dreg,6,smode,sreg,2} $ %(CHK (- A3) D2): (42643) %
define cmp(); case
EA wl(); if size = 2 and -32769<k<32768 then (size := 1; sext := cdr sext);
{11,dreg,4*size-1,smode,sreg,2} %(CMP (A3 +) A5): (135733) %
KD {11,dreg,size,7,4,2} %(CMP 3 D5): (135274 0 3) %
ED {11,dreg,size,smode,sreg,2} %(CMP (A3) D5): (135223) %
KE {0,6,size,dmode,dreg,3} %(CMP 3 (A4)): (06224 0 3) %
II {11,dreg,4+size,1,sreg,0} $ %(CMP (A3 +) (A4 +)): (134613)%
define da(m); case
DD {m,sreg,4+size,0,dreg,0} %(ADDX B D3 D4): (153404) %
PP {m,sreg,4+size,1,dreg,0} $ %(SUBX (- A3) (- A4)): (113614)%
define eor(); case
EA noa()
DE {11,sreg,4+size,dmode,dreg,1} %(EOR D2 (A5)): (132625) %
KE {0,5,size,dmode,dreg,3} %(EOR 3 (- A5)): (05245 0 3) %
KS siz(1); {0,5,size,7,4,2} %(EOR 3 SR): (05174 3) %
KC siz(0); {0,5,size,7,4,2} $ %(EOR 3 CCR): (05074 3) %
define exg(); case
DD {12,sreg,5,0,dreg,0} %(EXG D2 D3): (142503) %
AA {12,sreg,5,1,dreg,0} %(EXG A2 A3): (142513) %
DA {12,sreg,6,1,dreg,0} %(EXG D2 A3): (142613) %
AD {12,dreg,6,1,sreg,0} $ %(EXG A3 D2): (142613) %
define ext(); wl(); case
D {4,4,size+1,0,sreg,0} $ %(EXT D3): (44203) %
define imm(m); case
KE {0,m,size,dmode,dreg,3} $ %(SUBI 3 (A5)): (02225 0 3) %
define jmp(m,n); case
J {4,m,n,smode,sreg,2} %(JMP (5)): (47370 5) %
K {4,m,n,smode,sreg,2} $ %(JSR 5): (47270 5) %
define lea(); case JA {4,dreg,7,smode,sreg,2} $ %(LEA (PC 3) A5): (45772 3) %
define link(); case AK {4,7,1,2,sreg,1} $ %(LINK A5 3): (47125 3) %
define lgc(m); case
AD noa() EA noa()
DE {8+4*m,sreg,size,dmode,dreg,1} %(AND D3 (A5)): (143225) %
ED {8+4*m,dreg,size,dmode,dreg,2} %(OR (A5) D3): (103203) %
KE {0,m,size,dmode,dreg,3} %(AND 3 (A5)): (01225 0 3) %
KS siz(1); {0,m,size,7,4,2} %(OR 3 SR): (00174 3) %
KC siz(0); {0,m,size,7,4,2} $ %(AND 3 CCR): (01074 3) %
define lgci(m); case EA noa()
KE {0,m,size,dmode,dreg,3} $ %(ANDI 3 (A5)): (01225 0 3) %
define md(m,n); case
ED {m,dreg,n,smode,sreg,2} $ %(MULS (A5) D3): (143725) %
define move(); case
KA wl(); if size=2 and -32769<k<32768 then (size := 1; sext := cdr sext);
{nth(size,!'(1 3 2)),dreg,1,smode,sreg,2}
%(MOVE 3 A5): (35174 3) %
EA wl(); {nth(size,!'(1 3 2)),dreg,1,smode,sreg,2}
%(MOVE (A5) A6):(26125) %
KD if -257<k<256 and size=2 then [lsh(56+dreg,9)+k|8]
%(MOVE 3 D5): (75003) %
else {nth(size,!'(1 3 2)),dreg,dmode,7,4,2}
%(MOVE 256 D5): (25074 20 400)%
EE {nth(size,!'(1 3 2)),dreg,dmode,smode,sreg,3}
%(MOVE (PC) (A5)):(25272 0) %
EC siz(1); {4,2,3,smode,sreg,2} %(MOVE (A5) CCR): (42325) %
ES siz(1); {4,3,3,smode,sreg,2} %(MOVE (A5) SR): (43325) %
SE siz(1); {4,0,3,dmode,dreg,1} %(MOVE SR (A5)): (40325) %
AU {4,7,1,4,dreg,0} %(MOVE A3 USP): (47143) %
UA {4,7,1,5,dreg,0} %(MOVE USP A3): (47153) %
JM wl(); {4,6,size+1,smode,sreg,3} %(MOVE (A7) (M 24)):(46327 30)%
IM wl(); {4,6,size+1,smode,sreg,1} %(MOVE (A7 +) (M 24)):(46337 30)%
MJ wl(); {4,4,size+1,dmode,dreg,3} %(MOVE (M 24) (A7)):(44327 30)%
MP wl(); let ibase=2, base=2;
sext := [readlist reverse cdr exploden(2**16+car sext)];
{4,4,size+1,dmode,dreg,2} $ %(MOVE (M 24) (- A7)):(44347 14000)%
define movep(); wl(); case
XD {0,dreg,3+size,1,sreg,2} %(MOVEP (A3 5) D2): (02513 5)%
DX {0,sreg,5+size,1,dreg,1} $ %(MOVEP D2 (A3 5)): (02713 5)%
define moveq(); case
KD if -129<k<128 and size=2 then
[lsh(56+dreg,9)+k|8] %(MOVEQ -9 D5): (75367) %
else gripe "Illegal MOVEQ" $
define oea(m); case A noa()
E {4,m,size,smode,sreg,2} $ %(TST (A5)): (45225) %
define qtyp(m); case
OE {5,k|3,m+size,dmode,dreg,1} $ %(SUBQ 3 (A5)): (53625) %
define s(m); case
E {5,m/:2,m|1*4+3,smode,sreg,2} $ %(SMI (A5)): (55725) %
define sh(m,n); case
OD {14,k|3,m+size,n,dreg,0} %(ASL 3 D5): (163605) %
DD {14,sreg,m+size,4+n,dreg,0} %(ASR D3 D5): (163245) %
D {14,1,m+size,n,sreg,0} %(LSR D5): (161215) %
A noa()
E {14,n,m+3,smode,sreg,2} $ %(LSR (A5)): (161325) %
define stop(); 20082 . sext $ %(STOP 3): (47162 3) %
define swap(); case D {4,4,1,0,sreg,0} $ %(SWAP D3): (44103) %
define tn(m,n); case A noa()
E {4,m,n,smode,sreg,2} $ %(TAS (A5)): (45325) %
define trap(); case K [20032+k|4] $ %(TRAP 3): (47103) %
define unlk(); case A {4,7,1,3,sreg,0} $ %(UNLK A5): (47135) %
=exit$